           EJECT
      ***************************************************************
      *                                                             *
      *   THESE ARE COMMON SUBROUTINES TO HANDLE ERROR CONDITIONS   *
      *   FOR DB2 AND CICS PROCESSES.                               *
      *                                                             *
      ***************************************************************
           SKIP1
       Z900-DB2-CHECK.

           MOVE CA-PARAGRAPH-NBR TO DB2-PARAGRAPH-NBR.
           MOVE SQLCODE          TO DB2-SQL-RETURN-CODE.

           EVALUATE TRUE
               WHEN DB2-END-OF-FILE
                    IF OPEN-O-CLOSE-CURSOR OR
                       NORMAL-RC-ONLY
                       PERFORM Z900-DB2-ERROR
                    END-IF
               WHEN DB2-RECORD-NOT-FOUND
                    IF OPEN-O-CLOSE-CURSOR OR
                       NORMAL-RC-ONLY
                       PERFORM Z900-DB2-ERROR
                    END-IF
               WHEN DB2-DUPLICATE-KEY
                    IF DUP-KEY
                       NEXT SENTENCE
                    ELSE
                       PERFORM Z900-DB2-ERROR
                    END-IF
               WHEN DB2-MULTIPLE-ROWS
                    IF MULTIPLE-ROWS
                       NEXT SENTENCE
                    ELSE
                       PERFORM Z900-DB2-ERROR
                    END-IF
               WHEN DB2-NULL-VALUE-RETURN
                    IF NULL-VALUE
                       NEXT SENTENCE
                    ELSE
                       PERFORM Z900-DB2-ERROR
                    END-IF
               WHEN DB2-FATAL-ERROR
                       PERFORM Z900-DB2-ERROR
           END-EVALUATE.

           SET NORMAL-RC TO TRUE.

       Z900-DB2-ERROR.
           MOVE DB2-PARAGRAPH-NBR TO DB2-MSG-PARA-NBR.
           MOVE DB2-SQL-RETURN-CODE TO DB2-MSG-SQLCODE
           MOVE W0001-PROGRAM-NAME  TO DB2-MESSAGE-SQLERRMC.

           DISPLAY ALL '*'.
           DISPLAY ALL '*'.
           DISPLAY ALL ' '.
           DISPLAY ALL ' '.
           DISPLAY DB2-MESSAGE-AREA.
           DISPLAY ALL ' '.
           DISPLAY 'SQLERRMC = ' SQLERRMC.
           DISPLAY ALL ' '.
           DISPLAY ALL ' '.
           DISPLAY ALL '*'.
           DISPLAY ALL '*'.

           EXEC SQL
                ROLLBACK
           END-EXEC.

           MOVE SQLCODE TO DB2-SQL-RETURN-CODE.
           DISPLAY ' ROLLBACK SQLCODE: ' DB2-SQL-RETURN-CODE.

           MOVE +666 TO RETURN-CODE.

           GOBACK.

